home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / ispell40.lha / ispell-4.0 / ispell.el < prev    next >
Lisp/Scheme  |  1993-06-01  |  18KB  |  542 lines
  1. ;;   This is the GNU EMACS interface to GNU ISPELL version 4.
  2. ;;   Copyright (C) 1990, 1993 Free Software Foundation, Inc.
  3. ;;
  4. ;;   This file is part of GNU ISPELL.
  5. ;;
  6. ;;   This program is free software; you can redistribute it and/or modify
  7. ;;   it under the terms of the GNU General Public License as published by
  8. ;;   the Free Software Foundation; either version 2, or (at your option)
  9. ;;   any later version.
  10. ;;
  11. ;;   This program is distributed in the hope that it will be useful,
  12. ;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;   GNU General Public License for more details.
  15. ;;
  16. ;;   You should have received a copy of the GNU General Public License
  17. ;;   along with this program; if not, write to the Free Software
  18. ;;   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (defvar ispell-have-new-look t
  21.   "T if default 'look' program has the -r flag.")
  22.  
  23. (defvar ispell-enable-tex-parser nil
  24.   "T to enable experimental tex parser in ispell for tex buffers.")
  25.  
  26. (defvar ispell-process nil "The process running ISPELL")
  27. (defvar ispell-next-message nil
  28.   "An integer telling where in the *ispell* buffer where
  29. to look for the next message from the ISPELL program.")
  30.  
  31. ;Each marker in this list points to the start of a word that
  32. ;ispell thought was bad last time it did the :file command.
  33. ;Notice that if the user accepts or inserts a word into his
  34. ;private dictionary, then some "good" words will be on the list.
  35. ;We would like to deal with this by looking up the words again just before
  36. ;presenting them to the user, but that is too slow on machines
  37. ;without the select system call.  Therefore, see the variable
  38. ;ispell-recently-accepted.
  39. (defvar ispell-bad-words nil
  40.   "A list of markers corresponding to the output of the ISPELL :file command.")
  41.  
  42. ;list of words that the user has accepted, but that might still
  43. ;be on the bad-words list
  44. (defvar ispell-recently-accepted nil)
  45.  
  46. ;t when :dump command needed
  47. (defvar ispell-dump-needed nil)
  48.  
  49. (defun ispell-flush-bad-words ()
  50.   (while ispell-bad-words
  51.     (if (markerp (car ispell-bad-words))
  52.         (set-marker (car ispell-bad-words) nil))
  53.     (setq ispell-bad-words (cdr ispell-bad-words)))
  54.   (setq ispell-recently-accepted nil))
  55.  
  56. (defun kill-ispell ()
  57.   "Kill the ispell process.  Any changes the your private dictionay
  58. that have not already been dumped will be lost."
  59.   (interactive)
  60.   (if ispell-process
  61.       (delete-process ispell-process))
  62.   (setq ispell-process nil)
  63.   (ispell-flush-bad-words))
  64.  
  65. (put 'ispell-startup-error 'error-conditions
  66.      '(ispell-startup-error error))
  67. (put 'ispell-startup-error 'error-message
  68.      "Problem starting ispell - see buffer *ispell*")
  69.  
  70. (defun start-ispell ()
  71.   "Start an ispell subprocess; check the version; and display the greeting."
  72.   (message "Starting ispell ...")
  73.   (let ((buf (get-buffer "*ispell*")))
  74.     (if buf
  75.     (kill-buffer buf)))
  76.   (condition-case err
  77.       (setq ispell-process (start-process "ispell" "*ispell*" "ispell" "-S"))
  78.     (file-error (signal 'ispell-startup-error nil)))
  79.   (process-kill-without-query ispell-process)
  80.   (buffer-flush-undo (process-buffer ispell-process))
  81.   (accept-process-output ispell-process)
  82.   (let (last-char)
  83.     (save-excursion
  84.       (set-buffer (process-buffer ispell-process))
  85.       (bury-buffer (current-buffer))
  86.       (setq last-char (- (point-max) 1))
  87.       (while (not (eq (char-after last-char) ?=))
  88.     (cond ((not (eq (process-status ispell-process) 'run))
  89.            (kill-ispell)
  90.            (signal 'ispell-startup-error nil)))
  91.     (accept-process-output ispell-process)
  92.     (setq last-char (- (point-max) 1)))
  93.       (goto-char (point-min))
  94.       (let ((greeting (read (current-buffer))))
  95.     (if (not (= (car greeting) 1))
  96.         (error "Bad ispell version: wanted 1, got %d" (car greeting)))
  97.     (message (car (cdr greeting))))
  98.       (delete-region (point-min) last-char))))
  99.   
  100. ;leaves buffer set to *ispell*, point at '='
  101. (defun ispell-sync (intr)
  102.   "Make sure ispell is ready for a command."
  103.   (if (or (null ispell-process)
  104.       (not (eq (process-status ispell-process) 'run)))
  105.       (start-ispell))
  106.   (if intr
  107.       (interrupt-process ispell-process))
  108.   (let (last-char)
  109.     (set-buffer (process-buffer ispell-process))
  110.     (bury-buffer (current-buffer))
  111.     (setq last-char (- (point-max) 1))
  112.     (while (not (eq (char-after last-char) ?=))
  113.       (accept-process-output ispell-process)
  114.       (setq last-char (- (point-max) 1)))
  115.     (goto-char last-char)))
  116.  
  117. (defun ispell-cmd (&rest strings)
  118.   "Send a command to ispell.  Choices are:
  119.  
  120. word        any word is checked for spelling.  Result is
  121.  
  122.             nil            not found
  123.             t            spelled ok
  124.             list of strings        near misses
  125.  
  126. :file filename    scan the named file, and print the file offsets of
  127.         any misspelled words
  128.  
  129. :insert word    put word in private dictonary
  130.  
  131. :accept word    don't complain about word any more this session
  132.  
  133. :dump        write out the current private dictionary, if necessary.
  134.  
  135. :reload        reread ~/ispell.words
  136.  
  137. :tex
  138. :troff
  139. :generic    set type of parser to use when scanning whole files
  140. "
  141.   (save-excursion
  142.     (ispell-sync t)
  143.     (set-buffer (process-buffer ispell-process))
  144.     (bury-buffer (current-buffer))
  145.     (erase-buffer)
  146.     (setq ispell-next-message (point-min))
  147.     (while strings
  148.       (process-send-string ispell-process (car strings))
  149.       (setq strings (cdr strings)))
  150.     (process-send-string ispell-process "\n")
  151.     (accept-process-output ispell-process)
  152.     (ispell-sync nil)))
  153.  
  154. (defun ispell-dump ()
  155.   (cond (ispell-dump-needed
  156.      (setq ispell-dump-needed nil)
  157.      (ispell-cmd ":dump"))))
  158.  
  159. (defun ispell-insert (word)
  160.   (ispell-cmd ":insert " word)
  161.   (if ispell-bad-words
  162.       (setq ispell-recently-accepted (cons word ispell-recently-accepted)))
  163.   (setq ispell-dump-needed t))
  164.  
  165. (defun ispell-accept (word)
  166.   (ispell-cmd ":accept " word)
  167.   (if ispell-bad-words
  168.       (setq ispell-recently-accepted (cons word ispell-recently-accepted))))
  169.  
  170.  
  171. (defun ispell-next-message ()
  172.   "Return the next message sent by the ispell subprocess."
  173.   (save-excursion
  174.     (set-buffer (process-buffer ispell-process))
  175.     (bury-buffer (current-buffer))
  176.     (save-restriction
  177.       (goto-char ispell-next-message)
  178.       (narrow-to-region (point)
  179.                         (progn (forward-sexp 1) (point)))
  180.       (setq ispell-next-message (point))
  181.       (goto-char (point-min))
  182.       (read (current-buffer)))))
  183.  
  184. (defun ispell-tex-buffer-p ()
  185.   (memq major-mode '(plain-TeX-mode LaTeX-mode)))
  186.  
  187. (defun ispell (&optional buf start end)
  188.   "Run ispell over a buffer.  (Actually over the buffer's file.)
  189. First the file is scanned for misspelled words, then ispell
  190. enters a loop with the following commands for every misspelled word:
  191.  
  192. DIGIT    Near miss selector.  If the misspelled word is 'close' to
  193.     some words in the dictionary, they are offered as near misses.
  194. r    Replace.  Replace the word with a string you type.  Each word
  195.     of your new string is also checked.
  196. i    Insert.  Insert this word in your private dictonary (kept in
  197.     $HOME/ispell.words)
  198. a    Accept.  Accept this word for the rest of this editing session,
  199.      but don't put it in your private dictonary.
  200. l    Lookup.  Look for a word in the dictionary by fast binary
  201.     search, or search for a regular expression in the dictionary
  202.     using grep.
  203. SPACE    Accept the word this time, but complain if it is seen again.
  204. q, C-G    Leave the command loop.  You can come back later with \\[ispell-next]."
  205.   (interactive)
  206.   (if (null start)
  207.       (setq start 0))
  208.   (if (null end)
  209.       (setq end 0))
  210.  
  211.   (if (null buf)
  212.       (setq buf (current-buffer)))
  213.   (setq buf (get-buffer buf))
  214.   (if (null buf)
  215.       (error "Can't find buffer"))
  216.   (save-excursion
  217.     (set-buffer buf)
  218.     (let ((filename buffer-file-name)
  219.           (delete-temp nil))
  220.       (unwind-protect
  221.       (progn
  222.         (cond ((null filename)
  223.            (setq filename (make-temp-name "/usr/tmp/ispell"))
  224.            (setq delete-temp t)
  225.            (write-region (point-min) (point-max) filename))
  226.           ((and (buffer-modified-p buf)
  227.             (y-or-n-p (format "Save file %s? " filename)))
  228.            (save-buffer)))
  229.         (message "Ispell scanning file...")
  230.         (if (and ispell-enable-tex-parser
  231.              (ispell-tex-buffer-p))
  232.         (ispell-cmd ":tex")
  233.           (ispell-cmd ":generic"))
  234.         (ispell-cmd (format ":file %s %d %d" filename start end)))
  235.         (if delete-temp
  236.             (condition-case ()
  237.                 (delete-file filename)
  238.               (file-error nil)))))
  239.     (message "Parsing ispell output ...")
  240.     (ispell-flush-bad-words)
  241.     (let (pos bad-words)
  242.       (while (numberp (setq pos (ispell-next-message)))
  243.     ;;ispell may check the words on the line following the end
  244.     ;;of the region - therefore, don't record anything out of range
  245.     (if (or (= end 0)
  246.         (< pos end))
  247.         (setq bad-words (cons (set-marker (make-marker) (+ pos 1))
  248.                   bad-words))))
  249.       (setq bad-words (cons pos bad-words))
  250.       (setq ispell-bad-words (nreverse bad-words))))
  251.   (cond ((not (markerp (car ispell-bad-words)))
  252.      (setq ispell-bad-words nil)
  253.      (message "No misspellings."))
  254.     (t
  255.      (message "Ispell parsing done.")
  256.      (ispell-next))))
  257.  
  258. (defun ispell-next ()
  259.   "Resume command loop for most recent ispell command."
  260.   (interactive)
  261.   (unwind-protect
  262.       (catch 'quit
  263.     (save-window-excursion
  264.       (save-excursion
  265.         (let (next)
  266.           (while (markerp (setq next (car ispell-bad-words)))
  267.         (switch-to-buffer (marker-buffer next))
  268.         (push-mark)
  269.         (ispell-point next "at saved position.")
  270.         (setq ispell-bad-words (cdr ispell-bad-words))
  271.         (set-marker next nil))))))
  272.     (cond ((null ispell-bad-words)
  273.        (error "Ispell has not yet been run."))
  274.       ((markerp (car ispell-bad-words))
  275.        (message (substitute-command-keys
  276.                        "Type \\[ispell-next] to continue.")))
  277.       ((eq (car ispell-bad-words) nil)
  278.        (setq ispell-bad-words nil)
  279.        (message "No more misspellings (but checker was interrupted.)"))
  280.       ((eq (car ispell-bad-words) t)
  281.        (setq ispell-bad-words nil)
  282.        (message "Ispell done."))
  283.       (t
  284.        (setq ispell-bad-words nil)
  285.        (message "Bad ispell internal list"))))
  286.   (ispell-dump))
  287.  
  288.  
  289. (defun ispell-word ()
  290.   "Check the spelling of the word under the cursor.  See 'ispell'
  291. for more documentation."
  292.   (interactive)
  293.   (condition-case err
  294.       (catch 'quit
  295.     (save-window-excursion
  296.       (ispell-point (point) "at point."))
  297.     (ispell-dump))
  298.     (ispell-startup-error
  299.      (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ")
  300.         (load-library "spell")
  301.         (define-key esc-map "$" 'spell-word)
  302.         (spell-word))))))
  303.  
  304. (defun ispell-region (start &optional end)
  305.   "Check the spelling for all of the words in the region."
  306.   (interactive "r")
  307.   (ispell (current-buffer) start end))
  308.  
  309. (defun ispell-letterp (c)
  310.   (and c
  311.        (or (and (>= c ?A) (<= c ?Z))
  312.        (and (>= c ?a) (<= c ?z))
  313.        (>= c 128))))
  314.  
  315. (defun ispell-letter-or-quotep (c)
  316.   (and c
  317.        (or (and (>= c ?A) (<= c ?Z))
  318.        (and (>= c ?a) (<= c ?z))
  319.        (= c ?')
  320.        (>= c 128))))
  321.  
  322. (defun ispell-find-word-start ()
  323.   ;;backward to a letter
  324.   (if (not (ispell-letterp (char-after (point))))
  325.       (while (and (not (bobp))
  326.           (not (ispell-letterp (char-after (- (point) 1)))))
  327.     (backward-char)))
  328.   ;;backward to beginning of word
  329.   (while (ispell-letter-or-quotep (char-after (- (point) 1)))
  330.     (backward-char))
  331.   (skip-chars-forward "'"))
  332.  
  333. (defun ispell-find-word-end ()
  334.   (while (ispell-letter-or-quotep (char-after (point)))
  335.     (forward-char))
  336.   (skip-chars-backward "'"))
  337.  
  338. (defun ispell-next-word ()
  339.   (while (and (not (eobp))
  340.           (not (ispell-letterp (char-after (point)))))
  341.     (forward-char)))
  342.  
  343. ;if end is nil, then do one word at start
  344. ;otherwise, do all words from the beginning of the word where
  345. ;start points, to the end of the word where end points
  346. (defun ispell-point (start message)
  347.   (let ((wend (make-marker))
  348.     rescan
  349.     end)
  350.   (save-excursion
  351.     (goto-char start)
  352.     (ispell-find-word-start)        ;find correct word start
  353.     (setq start (point-marker))
  354.     (ispell-find-word-end)        ;now find correct end
  355.     (setq end (point-marker))
  356.     (if (>= start end)
  357.     (error "No word %s" message))
  358.     (while (< start end)
  359.       (goto-char start)
  360.       (ispell-find-word-end)        ;find end of current word
  361.                     ;could be before 'end' if
  362.                     ;user typed replacement
  363.                     ;that is more than one word
  364.       (set-marker wend (point))
  365.       (setq rescan nil)
  366.       (setq word (buffer-substring start wend))
  367.       (cond ((ispell-still-bad word)
  368.          (goto-char start);just to show user where we are working
  369.          (sit-for 0)
  370.          (message (format "Ispell checking %s" word))
  371.          (ispell-cmd word)
  372.          (let ((message (ispell-next-message)))
  373.            (cond ((eq message t)
  374.               (message "%s: ok" word))
  375.              ((or (null message)
  376.               (consp message))
  377.               (setq rescan
  378.                 (ispell-command-loop word start wend message)))
  379.              (t
  380.               (error "unknown ispell response %s" message))))))
  381.       (cond ((null rescan)
  382.          (goto-char wend)
  383.          (ispell-next-word)
  384.          (set-marker start (point)))))
  385.     ;;clear the choices buffer; otherwise it's hard for the user to tell
  386.     ;;when we get back to the command loop
  387.     (let ((buf (get-buffer "*ispell choices*")))
  388.       (cond (buf
  389.          (set-buffer buf)
  390.          (erase-buffer))))
  391.     (set-marker start nil)
  392.     (set-marker end nil)
  393.     (set-marker wend nil))))
  394.   
  395. (defun ispell-still-bad (word)
  396.   (let ((words ispell-recently-accepted)
  397.     (ret t)
  398.     (case-fold-search t))
  399.     (while words
  400.       (cond ((eq (string-match (car words) word) 0)
  401.          (setq ret nil)
  402.          (setq words nil)))
  403.       (setq words (cdr words)))
  404.     ret))
  405.  
  406. (defun ispell-show-choices (word message first-line)
  407.   ;;if there is only one window on the screen, make the ispell
  408.   ;;messages winow be small.  otherwise just use the other window
  409.   (let* ((selwin (selected-window))
  410.      (resize (eq selwin (next-window)))
  411.      (buf (get-buffer-create "*ispell choices*"))
  412.      w)
  413.     (setq w (display-buffer buf))
  414.     (buffer-flush-undo buf)
  415.     (if resize
  416.     (unwind-protect
  417.         (progn
  418.           (select-window w)
  419.           (enlarge-window (- 6 (window-height w))))
  420.       (select-window selwin)))
  421.     (save-excursion
  422.       (set-buffer buf)
  423.       (bury-buffer buf)
  424.       (set-window-point w (point-min))
  425.       (set-window-start w (point-min))
  426.       (erase-buffer)
  427.       (insert first-line "\n")
  428.       (insert
  429.        "SPC skip; A accept; I insert; DIGIT select; R replace; \
  430. L lookup; Q quit\n")
  431.       (cond ((not (null message))
  432.          (let ((i 0))
  433.            (while (< i 3)
  434.          (let ((j 0))
  435.            (while (< j 3)
  436.              (let* ((n (+ (* j 3) i))
  437.                 (choice (nth n message)))
  438.                (cond (choice
  439.                   (let ((str (format "%d %s" n choice)))
  440.                 (insert str)
  441.                 (insert-char ?  (- 20 (length str)))))))
  442.              (setq j (+ j 1))))
  443.          (insert "\n")
  444.          (setq i (+ i 1)))))))))
  445.  
  446. (defun ispell-command-loop (word start end message)
  447.   (let ((flag t)
  448.     (rescan nil)
  449.     first-line)
  450.     (if (null message)
  451.     (setq first-line (concat "No near misses for '" word "'"))
  452.       (setq first-line (concat "Near misses for '" word "'")))
  453.     (while flag
  454.       (ispell-show-choices word message first-line)
  455.       (message "Ispell command: ")
  456.       (let ((c (downcase (read-char)))
  457.         replacement)
  458.     (cond ((and (>= c ?0)
  459.             (<= c ?9)
  460.             (setq replacement (nth (- c ?0) message)))
  461.            (ispell-replace start end replacement)
  462.            (setq flag nil))
  463.           ((= c ?q)
  464.            (throw 'quit nil))
  465.           ((= c ? )
  466.            (setq flag nil))
  467.           ((= c ?r)
  468.            (ispell-replace start end (read-string "Replacement: "))
  469.            (setq rescan t)
  470.            (setq flag nil))
  471.           ((= c ?i)
  472.            (ispell-insert word)
  473.            (setq flag nil))
  474.           ((= c ?a)
  475.            (ispell-accept word)
  476.            (setq flag nil))
  477.           ((= c ?l)
  478.            (let ((val (ispell-do-look word)))
  479.          (setq first-line (car val))
  480.          (setq message (cdr val))))
  481.           ((= c ??)
  482.            (message
  483.         "Type 'C-h d ispell' to the emacs main loop for more help")
  484.            (sit-for 2))
  485.           (t
  486.            (message "Bad ispell command")
  487.            (sit-for 2)))))
  488.     rescan))
  489.  
  490. (defun ispell-do-look (bad-word)
  491.   (let (regex buf words)
  492.     (cond ((null ispell-have-new-look)
  493.        (setq regex (read-string "Lookup: ")))
  494.       (t
  495.        (setq regex (read-string "Lookup (regex): " "^"))))
  496.     (setq buf (get-buffer-create "*ispell look*"))
  497.     (save-excursion
  498.       (set-buffer buf)
  499.       (delete-region (point-min) (point-max))
  500.       (if ispell-have-new-look
  501.       (call-process "look" nil buf nil "-r" regex)
  502.     (call-process "look" nil buf nil regex))
  503.       (goto-char (point-min))
  504.       (forward-line 10)
  505.       (delete-region (point) (point-max))
  506.       (goto-char (point-min))
  507.       (while (not (= (point-min) (point-max)))
  508.     (end-of-line)
  509.     (setq words (cons (buffer-substring (point-min) (point)) words))
  510.     (forward-line)
  511.     (delete-region (point-min) (point)))
  512.       (kill-buffer buf)
  513.       (cons (format "Lookup '%s'" regex)
  514.         (reverse words)))))
  515.     
  516. (defun ispell-replace (start end new)
  517.   (goto-char start)
  518.   (insert new)
  519.   (delete-region (point) end))
  520.  
  521. (defun reload-ispell ()
  522.   "Tell ispell to re-read your private dictionary."
  523.   (interactive)
  524.   (ispell-cmd ":reload"))
  525.  
  526. (define-key esc-map "$" 'ispell-word)
  527. (define-key ctl-x-map "$" 'ispell-next)
  528.  
  529. (defun batch-make-ispell ()
  530.   (byte-compile-file "ispell.el"))
  531.   ;; Don't do this anymore, because it should be determined by the Makefile
  532.   ;; whether it is necessary (by default it shouldn't be).  Also, makeinfo
  533.   ;; is more robust.  --friedman 31-May-93
  534.   ;(find-file "ispell.texinfo")
  535.   ;(let ((old-dir default-directory)
  536.   ;    (default-directory "/tmp"))
  537.   ;  (texinfo-format-buffer))
  538.   ;(Info-validate)
  539.   ;(if (get-buffer " *problems in info file*")
  540.   ;    (kill-emacs 1))
  541.   ;(write-region (point-min) (point-max) "ispell.info"))
  542.